home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
yerk 3.66
/
System source
/
Event
< prev
next >
Wrap
Text File
|
1994-06-24
|
7KB
|
241 lines
\ Modification History
\ 4/16/84 NDI Version 1.0
\ 4/20/84 NDI Added ClickAction, replaces Middleman
\ 5/07/84 NDI now inits FEVENT, uses CALL:
\ 8/16/84 CBD MOUSE-EVT handles window directly
\ 8/26/84 CBD Deferred methods for windows
\ 10/12/84 CBD use objPtr for MenuBar
\ 10/25/84 CBD Added click time for double-click use
\ 11/11/84 CBD Added interval timer, wait, Mouse
\ 1/14/84 cbd Added modeless dialog support
\ 12/08/85 cdn Fixed put: & click: methods in Mouse
\ Added NULL-EVT-IDLE
\ 4/15/86 cdn Removed NULL-EVT-IDLE in favor of actW semaphore
\ 8/26/86 cdn Upgraded DISK-EVT to automatically mount volume
\ 8/31/88 rfl added zoomWindow support
\ 3/22/90 rfl multifinder compatible. removed call systemtask for nullevt
\ as well as other things
\ 5/29/90 rfl handle bad disk mounts
\ 7/25/90 rfl modified upd-evt and actv-evt for waitnextevent and non-multifinder
\ 9/30/90 rfl next: doesn't need ^base; .pause now in nucleus
\ 10.25.90 rfl added deactivate and activate messages in multifinder event
\ 12/21/90 rfl getevent now needs nothing on the stack. This means there can
\ never be more than one event object.
\ 1/31/90 rfl font stuff moved to file
\ 6/08/91 rfl high level events support
\ 10/26/91 rfl added abort load in (nevent) for either decho state
\ 5/07/93 rfl added modifier key detection
\ 5/28/93 rfl fixed hl-Evt to leave the advertised 0 on stack
Decimal
'c (nevent1) -> nEvent \ use as stub until Event is loaded
\ forward reference the menu bar
0 value MenuBar
\ max ticks for double click
: dblTicks $ 2f0 -base @ ;
hex
create intSwap
2017 w, \ move.l (sp),d0
4840 w, \ swap d0
2e80 w, \ move.l d0,(sp)
next,
decimal
0 variable theDlg
0 variable thePoint
\ ( gy:gx -- ly:lx ) convert a global point to a local point
: G->L
thePoint ! thePoint +base
call GlobalToLocal thePoint @ ;
: l->g thePoint ! thePoint +base call LocalToGlobal thePoint @ ;
:CLASS Event <Super X-Array
Int Evt
Var Msg
Var Time
Var Loc
Int Mods
Int Mask
Var Sleep
Var MouseRgn
:M SLEEP: put: Sleep ;M
:M MouseRgn: put: mouseRgn ;M
:M TYPE: get: Evt ;M
:M MODS: get: Mods ;M
:M SET: put: Mask ;M
:M MSG: get: Msg ;M
\ ( -- mpoint ) leaves mouse loc as global toolbox Point
:M WHERE: get: loc ;M
\ ( -- #secs ) Leave ticks
:M WHEN: get: Time ;M
\ get the next event and exec its handler
\ ( -- b ) True if we should exit to caller
:M NEXT:
getEvent
IF get: Evt ELSE 0 THEN
exec: super
;M
\ ( -- ) handle events until a key event occurs
:M KEY: BEGIN next: self UNTIL ;M
;CLASS
' Event 'c fEvent !
\ define the mouse as an object
:CLASS Mouse <Super Object
Var Last \ ticks when last click occurred
Var Interval \ ticks between clicks
\ ( ticks -- ) update the click interval with current sysTicks value
:M PUT: dup get: last - put: interval put: last ;M
\ ( -- type ) return the type of click that last occurred: 2=double
:M CLICK: get: interval dup 0> swap dblTicks < and
IF 2 ELSE 1 THEN ;M
\ return the mouse position as local point
:M WHERE: ?terminal drop where: fEvent g->l unPack ;M
\ return the current state of the mouse - position and button
\ ( -- x y but ) button non-0 if down
:M GET: where: self word0 call Button word0 ;M
;CLASS
Mouse theMouse
\ return true if mouse button is still down
: StillDown? word0 call StillDown word0 ;
\ wait until a mouse click or key event
: waitClick BEGIN 10 ?event UNTIL ;
\ ( -- ) Desktop click handler
: Desk ;
\ ( wind -- ) System click handler
: Sys +base abs: fEvent swap call SystemClick ;
0 value actW \ Indentifies any active Yerk window which should be idled
\ ( -- 0 ) NULL, KEYUP, NETW, DRVR, application events
: NULL-EVT 0 actW -dup IF idle: [ ] THEN ; \ If active YERK window, send idle
\ ( -- 0 ) mouse down event - perform a window-action
: MOUSE-EVT
when: fEvent put: theMouse \ update click interval
where: fEvent find-Window swap
Select{ \ Region handlers
0 Is{ Drop Desk }End
1 Is{ Drop click: MenuBar }End
2 Is{ Sys }End
3 Is{ content: [ ] }End
4 Is{ drag: [ ] }End
5 Is{ grow: [ ] }End
6 Is{ Dup +Base >R Word0 R> where: fEvent
call TrackGoAway word0
IF close: [ ]
ELSE Drop THEN }End
7 Is{ 7 swap zoom: [ ] }End
8 Is{ 8 swap zoom: [ ] }End
Default{ abort
}Select 0
;
\ checks to see if window belongs to the application - necessary for
\ non-multifinder systems while calling waitnextevent
: isAppWindow ( windPtr -- windPtr b) dup 108 + w@ 8 = ;
\ ( -- keywd modswd t OR f ) get key value
: KEY-EVT 0 call frontwindow -base isappwindow swap drop
IF mods: fEvent $ 100 and \ command key?
IF msg: fEvent key: menuBar 0 \ check for menu selection
ELSE msg: fEvent mods: fEvent 1
THEN
ELSE 0
THEN ;
\ ( -- 0 ) handle a disk insert event
: DISK-EVT watchcurs
msg: fevent intSwap extend 0<
IF word0 150 100 pack msg: fevent call dIBadMount i->l drop
ELSE 154 newPtr msg: fEvent over 22 + w!
dup fcall PBOffline drop
dup fcall PBMountVol drop
killPtr
THEN arrowcurs 0 ;
\ ( -- 0 ) cause window draw
: UPD-EVT msg: fEvent -base isAppWindow
IF draw: [ ] ELSE drop THEN 0 ;
\ ( -- 0 ) activate, draw window
: ACTV-EVT
msg: fEvent -base isAppWindow \ get the window object
IF mods: fEvent 01 and
IF enable: [ ]
ELSE disable: [ ]
THEN
ELSE drop
THEN 0 ;
true value inForeGround
nullcfa vect resume
nullcfa vect suspend
nullcfa vect cvtClip
nullcfa vect mouseMoved
'c drop vect appleEvt
'c drop vect hlevt
0 value saveWind
( -- 0)
: OS-Evt
msg: fevent $ 1000000 and
IF msg: fevent 1 and
IF saveWind -> actw enable: actw true -> inForeGround resume
ELSE actw -> saveWind disable: actw false -> inForeGround suspend
THEN
msg: fevent 2 and IF cvtClip THEN
ELSE msg: fevent $ FA000000 and
IF mouseMoved THEN
THEN 0 ;
( -- 0) \ High level events
: HL-Evt where: fevent msg: fevent 'type aevt =
IF AppleEvt ELSE hlEvt THEN 0 ;
: key key: fEvent drop $ ff and ;
'c key ' abort 16 + !
: rekey 'c key -> keyvec ;
\ these check if a particular modifier key is down. They do not check
\ if the particular key is the ONLY modifier key down.
: command? ( -- b) mods: fevent $ 100 and 0> ; \ command key down?
: shift? ( -- b) mods: fevent $ 200 and 0> ; \ is the shift key held down?
: ctl? ( -- b) mods: fevent $ 1000 and 0> ;
: option? ( -- b) mods: fevent $ 800 and 0> ; \ you get the idea
\ put it nEvent later - allow background loading and a way to abort
: (nEvent) next: fevent
IF 2drop \ decho
.pause key 32 <> IF abort THEN
THEN ;